; ORIGINAL: 3dt2.1/examples/polygon.scm
; $Id: polygon.scm,v 1.5 1998/09/29 16:06:46 jmb Exp $
; ---------------------------------------------------------------------
;    File: POLYGON.SCM
;   Notes: Rubberbands an n-sided polygon.
;
;   Usage: (polygon num_sides)
;  Action: pick the center
;          rubberband a radius from which polygon is inscribed
; ---------------------------------------------------------------------

(define polygon (lambda (sides)
    (let* (
          (center (pick:position (read-ray)))
          (curr_view #f)

          ;; define a vector to contain the vertex positions. We
          ;; add an extra position that duplicates the start position
          ;; to draw a closed polygon.
          (points (make-vector (+ sides 1) (position 0 0 0)))

          ;; compute the transformation from one vertex to the next
          (trans (transform:rotation center (gvector 0 0 1) (/ 360 sides)))

          ;; define a procedure to compute the new vertices. Each element
          ;; of a vector is a scheme object.
          (compute (lambda (pos)
              ;; save this position in the first and last elements
              (vector-set! points 0     (position:copy pos))
              (vector-set! points sides (position:copy pos))

              ;; transform previous point and store in current element
              (do ((i 1 (+ i 1))) ((= i sides))
                  (vector-set! points i
                      (position:transform (vector-ref points (- i 1)) trans))
                  )
              ))

          ;; define a procedure to draw/undraw the rubber band polygon
          (draw (lambda ()
              (if curr_view
                  (begin
                  (view:set-rb-mode #t curr_view)
                  (view:draw-polyline points curr_view)
                  (view:set-rb-mode #f curr_view)
                  ))
              ))

          ;; set rubberbanding hooks
          (rb_hooks (make-vector 7))
          )

          (begin

          (vector-set! rb_hooks 0 (lambda (self)      ;; INIT
                  (display "init\n")
                  ))
          (vector-set! rb_hooks 1 (lambda (self pe)   ;; START
                  (display "start\n")
                  (set! curr_view (event:view pe))
                  (draw)
                  ))
          (vector-set! rb_hooks 2 (lambda (self pe)   ;; UPDATE
                  (display "update\n")
                  (if curr_view
                      (begin
                      (draw)
                      (compute (pick:position pe))
                      (draw)
                      ))
                  ))
          (vector-set! rb_hooks 3 (lambda (self)      ;; STOP
                  (display "stop\n")
                  (draw)
                  ))
          (vector-set! rb_hooks 4 (lambda (self v)    ;; REPAINT
                  (display "repaint\n")
                  (if (equal? v curr_view)
                      (draw)
                      )
                  ))
          (vector-set! rb_hooks 5 (lambda (self pe)   ;; POSITION
                  (display "position\n")
                  ))
          (vector-set! rb_hooks 6 (lambda (self)      ;; END
                  (display "end\n")
                  (set! curr_view #f)
                  ))

          ;; create and activate the rubberband driver
          (rbd:scheme #t rb_hooks)

          (let ((stop_pos (pick:position (read-ray)))
                (edge_list (make-vector sides #f)))

              (begin
              ;; stop rubberbanding
              (rbd:remove-type rbd:scheme?)

              ;; compute final vertices
              (compute stop_pos)

              ;; create wire body of edges between vertices
              (do ((i 0 (+ i 1))) ((= i sides))
                  (vector-set! edge_list i (edge:linear (vector-ref points i)
                      (vector-ref points (+ i 1))))
                  )
              (wire-body (vector->list edge_list))
              )
          ))
    )
))

; ----------------------------------
;  End of POLYGON.SCM
; ----------------------------------
